home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / NETMISC.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  10KB  |  361 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  5-27-88 8:15 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit NetMisc;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, Core1, Core2;
  19.   
  20.   
  21. function Fido_FormTAD(t : tad_array)  : StrTAD;
  22.  
  23. procedure fido_sort(var high_msg_num,
  24.                     number_of_msgs  : Integer;
  25.                     var msg_nums    : msg_array);
  26.                     
  27. procedure show_nets;
  28.  
  29. procedure check_net(num             : Integer;
  30.                     var offset,
  31.                     number_nodes    : Integer;
  32.                     var OK          : Boolean);
  33.                     
  34. procedure check_node(num, net_start,
  35.                      number_nodes    : Integer;
  36.                      var OK          : Boolean);
  37.                      
  38. procedure show_nodes(offset, num_nodes : Integer);
  39.  
  40.  
  41.   {==========================================================================}
  42.   
  43.   
  44. Implementation
  45.  
  46.  
  47.   function Fido_FormTAD(t : tad_array)  : StrTAD;
  48.     { Build printable string of current time and date for SeaDog messages }
  49.     
  50.   const
  51.     month : array[1..12] of string[3] =
  52.     ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  53.     
  54.   var
  55.     i               : Integer;
  56.     line, line1     : StrTAD;
  57.     
  58.   begin
  59.     if (t[1] in [0..59]) and (t[2] in [0..23]) then
  60.       line := intstr(t[2], 2)+':'+intstr(t[1], 2)+':'+intstr(t[0], 2)
  61.     else
  62.       line := '';
  63.     for i := 1 to Length(line) do
  64.       if line[i] = ' ' then
  65.         line[i] := '0';
  66.     line1 := intstr(t[3], 2);
  67.     if line1[1] = ' ' then line1[1] := '0';
  68.     if (t[3] in [1..31]) and (t[4] in [1..12]) and (t[5] in [0..99]) then
  69.       Fido_FormTAD := line1+' '+month[t[4]]+' '+intstr(t[5], 2)+' '+line
  70.     else
  71.       Fido_FormTAD := 'No Date'
  72.   end;
  73.   
  74.   
  75.   procedure shell_sort(var values      : msg_array;
  76.                        lower_bound,
  77.                        upper_bound     : Integer;
  78.                        is_ascending    : Boolean);
  79.                        
  80.   var
  81.     i, gap          : Integer;
  82.     exch_occurred   : Boolean;
  83.     
  84.     procedure Swap(var a, b : Integer);
  85.     
  86.     var
  87.       t               : Integer;
  88.       
  89.     begin
  90.       t := a;
  91.       a := b;
  92.       b := t
  93.     end;
  94.     
  95.   begin
  96.     gap := Abs((upper_bound-lower_bound)+1) div 2;
  97.     repeat
  98.       repeat
  99.         exch_occurred := False;
  100.         for i := lower_bound to upper_bound-gap do
  101.           if ((values[i] > values[i+gap]) and (is_ascending)) then
  102.             begin
  103.               Swap(values[i], values[i+gap]);
  104.               exch_occurred := True
  105.             end
  106.           else if ((values[i] < values[i+gap]) and (not is_ascending)) then
  107.             begin
  108.               Swap(values[i], values[i+gap]);
  109.               exch_occurred := True
  110.             end;
  111.       until (not exch_occurred);
  112.       gap := gap div 2;
  113.     until (gap = 0);
  114.   end;
  115.   
  116.   
  117.   procedure fido_sort(var high_msg_num,
  118.                       number_of_msgs  : Integer;
  119.                       var msg_nums    : msg_array);
  120.                       
  121.      { Finds the highest numbered message, and puts
  122.        all the message numbers in a sorted array }
  123.        
  124.   var
  125.     i, n,
  126.     this_msg_num    : Integer;
  127.     Filname         : DosFileName;
  128.     mask            : StrPr;
  129.     abort           : Boolean;
  130.     DirInfo         : SearchRec;
  131.     attribute       : Word;
  132.     
  133.     
  134.     procedure getname;
  135.     
  136.     begin
  137.       Filname := DirInfo.name;
  138.       i := 1;
  139.       while Filname[i] <> '.' do
  140.         Inc(i);
  141.       i := Pred(i);
  142.       Filname[0] := Chr(i);
  143.     end;
  144.     
  145.   begin                           {fido_sort}
  146.     FillChar(msg_nums, 2048, 0);
  147.     abort := False;
  148.     high_msg_num := 0;
  149.     n := 0;
  150.     mask := '*.MSG'+Chr(0);
  151.     if AreaReq = 'NETMAIL' then
  152.       SetSect(fidomail)
  153.     else
  154.       SetSect(fidomail+'\'+AreaReq);
  155.     Filname := '';
  156.     attribute := 39;
  157.     FindFirst(mask, attribute, DirInfo);
  158.     if DosError = 0 then
  159.       begin
  160.         n := 1;
  161.         getname;
  162.         high_msg_num := strint(Filname);
  163.         msg_nums[n] := high_msg_num;
  164.         repeat
  165.           FindNext(DirInfo);
  166.           if DosError <> 18 then
  167.             begin
  168.               Inc(n);
  169.               getname;
  170.               this_msg_num := strint(Filname);
  171.               if high_msg_num < this_msg_num then
  172.                 high_msg_num := this_msg_num;
  173.               msg_nums[n] := this_msg_num;
  174.             end;
  175.         until DosError <> 0;
  176.       end;
  177.     SetSect(HomName);
  178.     number_of_msgs := n;
  179.     if number_of_msgs > 0 then
  180.       shell_sort(msg_nums, 1, number_of_msgs, True);
  181.   end;
  182.   
  183.   
  184.   
  185.   procedure show_nets;
  186.   
  187.   type
  188.     Str20           = string[20];
  189.     Str40           = string[40];
  190.     
  191.   var
  192.     i, x,
  193.     lines,
  194.     offset          : Integer;
  195.     str_name        : Str20;
  196.     str_city        : Str40;
  197.     
  198.   begin
  199.     SetSect(fidolists);
  200.     lines := 1;
  201.     WriteLn(Com);
  202.     with net_hdr do
  203.       begin
  204.         Assign(net_file, netlist);
  205.         Reset(net_file);
  206.         x := 0;
  207.         abort := False;
  208.         while (x < (FileSize(net_file))) and Online and (not brk) do
  209.           begin
  210.             Seek(net_file, x);
  211.             Read(net_file, net_hdr);
  212.             Write(Com, 'Net  ', net_num:4, '  ');
  213.             offset := node_ptr;
  214.             i := 1;
  215.             while (net_name[i] <> Chr(0)) and (i <> 20) do
  216.               begin
  217.                 str_name[i] := net_name[i];
  218.                 Inc(i)
  219.               end;
  220.             str_name[0] := Chr(i-1);
  221.             if str_name[19] = ' ' then Delete(str_name, 19, 1);
  222.             Write(Com, str_name:21, '    ');
  223.             i := 1;
  224.             while (net_city[i] <> Chr(0)) and (i <> 40) do
  225.               begin
  226.                 str_city[i] := net_city[i];
  227.                 Inc(i)
  228.               end;
  229.             str_city[0] := Chr(i-1);
  230.             WriteLn(Com, str_city);
  231.             Inc(lines);
  232.             if lines mod user_rec.lines = 0 then
  233.               pause;
  234.             Inc(x)
  235.           end;
  236.         Close(net_file);
  237.       end;
  238.     SetSect(HomName);
  239.   end;
  240.   
  241.   
  242.   procedure check_net(num             : Integer;
  243.                       var offset,
  244.                       number_nodes    : Integer;
  245.                       var OK          : Boolean);
  246.                       
  247.   var
  248.     x               : Integer;
  249.     
  250.   begin
  251.     SetSect(fidolists);
  252.     OK := False;
  253.     with net_hdr do
  254.       begin
  255.         Assign(net_file, netlist);
  256.         Reset(net_file);
  257.         x := 0;
  258.         while (x < (FileSize(net_file))) and (not OK) do
  259.           begin
  260.             Seek(net_file, x);
  261.             Read(net_file, net_hdr);
  262.             offset := node_ptr;
  263.             number_nodes := num_nodes;
  264.             Inc(x);
  265.             OK := (net_num = num);
  266.           end;
  267.         Close(net_file);
  268.       end;
  269.     SetSect(HomName);
  270.   end;
  271.   
  272.   
  273.   
  274.   procedure check_node(num, net_start,
  275.                        number_nodes    : Integer;
  276.                        var OK          : Boolean);
  277.                        
  278.   var
  279.     i, x            : Integer;
  280.     
  281.   begin
  282.     SetSect(fidolists);
  283.     OK := False;
  284.     with node_hdr do
  285.       begin
  286.         Assign(node_file, nodelist);
  287.         Reset(node_file);
  288.         x := net_start;
  289.         i := 1;
  290.         while (x < (FileSize(node_file))) and (not OK) and (i <= number_nodes) do
  291.           begin
  292.             Seek(node_file, x);
  293.             Read(node_file, node_hdr);
  294.             Inc(x);
  295.             Inc(i);
  296.             OK := (node_num = num)
  297.           end;
  298.         Close(node_file);
  299.       end;
  300.     SetSect(HomName);
  301.   end;
  302.   
  303.   
  304.   procedure show_nodes(offset, num_nodes : Integer);
  305.   
  306.   type
  307.     Str20           = string[20];
  308.     Str40           = string[40];
  309.     
  310.   var
  311.     i, x,
  312.     lines           : Integer;
  313.     str_name        : Str20;
  314.     str_city        : Str40;
  315.     
  316.   begin
  317.     SetSect(fidolists);
  318.     abort := False;
  319.     WriteLn(Com);
  320.     with node_hdr do
  321.       begin
  322.         Assign(node_file, nodelist);
  323.         Reset(node_file);
  324.         Seek(node_file, offset);
  325.         x := 1;
  326.         lines := 1;
  327.         while (x <= num_nodes) and (not brk) and (Online) do
  328.           begin
  329.             Read(node_file, node_hdr);
  330.             Write(Com, 'Node  ', node_num:4, '  ');
  331.             i := 1;
  332.             while (node_name[i] <> Chr(0)) and (i <> 20) do
  333.               begin
  334.                 str_name[i] := node_name[i];
  335.                 Inc(i)
  336.               end;
  337.             str_name[0] := Chr(i-1);
  338.             if str_name[19] = ' ' then Delete(str_name, 19, 1);
  339.             Write(Com, str_name:21, '    ');
  340.             i := 1;
  341.             while (node_city[i] <> Chr(0)) and (i <> 40) do
  342.               begin
  343.                 str_city[i] := node_city[i];
  344.                 Inc(i)
  345.               end;
  346.             str_city[0] := Chr(i-1);
  347.             WriteLn(Com, str_city);
  348.             Inc(lines);
  349.             if lines mod user_rec.lines = 0 then
  350.               pause;
  351.             Inc(x)
  352.           end;
  353.         Close(node_file)
  354.       end;
  355.     SetSect(HomName)
  356.   end;
  357.   
  358.   
  359. end.                              { of NETMISC.PAS}
  360. 
  361.